home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Ibrowse __250098202001.psc / frm_thumbs.frm (.txt) < prev   
Encoding:
Visual Basic Form  |  2001-08-21  |  8.4 KB  |  253 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Begin VB.Form frm_thumbs 
  4.    BackColor       =   &H80000001&
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "<folder name>"
  7.    ClientHeight    =   5430
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   6510
  11.    Icon            =   "frm_thumbs.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MDIChild        =   -1  'True
  15.    ScaleHeight     =   5430
  16.    ScaleWidth      =   6510
  17.    Begin MSComctlLib.ImageList ils_images 
  18.       Left            =   120
  19.       Top             =   120
  20.       _ExtentX        =   1005
  21.       _ExtentY        =   1005
  22.       BackColor       =   -2147483643
  23.       ImageWidth      =   16
  24.       ImageHeight     =   16
  25.       MaskColor       =   12632256
  26.       _Version        =   393216
  27.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  28.          NumListImages   =   1
  29.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  30.             Picture         =   "frm_thumbs.frx":058A
  31.             Key             =   "noimage"
  32.          EndProperty
  33.       EndProperty
  34.    End
  35.    Begin VB.HScrollBar hsc_scroll 
  36.       Height          =   255
  37.       Left            =   60
  38.       TabIndex        =   0
  39.       Top             =   5100
  40.       Width           =   6375
  41.    End
  42.    Begin VB.Image img_thumb 
  43.       Height          =   1575
  44.       Index           =   11
  45.       Left            =   4920
  46.       MousePointer    =   2  'Cross
  47.       Stretch         =   -1  'True
  48.       Top             =   3420
  49.       Width           =   1515
  50.    End
  51.    Begin VB.Image img_thumb 
  52.       Height          =   1575
  53.       Index           =   10
  54.       Left            =   3300
  55.       MousePointer    =   2  'Cross
  56.       Stretch         =   -1  'True
  57.       Top             =   3420
  58.       Width           =   1515
  59.    End
  60.    Begin VB.Image img_thumb 
  61.       Height          =   1575
  62.       Index           =   9
  63.       Left            =   1680
  64.       MousePointer    =   2  'Cross
  65.       Stretch         =   -1  'True
  66.       Top             =   3420
  67.       Width           =   1515
  68.    End
  69.    Begin VB.Image img_thumb 
  70.       Height          =   1575
  71.       Index           =   8
  72.       Left            =   60
  73.       MousePointer    =   2  'Cross
  74.       Stretch         =   -1  'True
  75.       Top             =   3420
  76.       Width           =   1515
  77.    End
  78.    Begin VB.Image img_thumb 
  79.       Height          =   1575
  80.       Index           =   7
  81.       Left            =   4920
  82.       MousePointer    =   2  'Cross
  83.       Stretch         =   -1  'True
  84.       Top             =   1740
  85.       Width           =   1515
  86.    End
  87.    Begin VB.Image img_thumb 
  88.       Height          =   1575
  89.       Index           =   6
  90.       Left            =   3300
  91.       MousePointer    =   2  'Cross
  92.       Stretch         =   -1  'True
  93.       Top             =   1740
  94.       Width           =   1515
  95.    End
  96.    Begin VB.Image img_thumb 
  97.       Height          =   1575
  98.       Index           =   5
  99.       Left            =   1680
  100.       MousePointer    =   2  'Cross
  101.       Stretch         =   -1  'True
  102.       Top             =   1740
  103.       Width           =   1515
  104.    End
  105.    Begin VB.Image img_thumb 
  106.       Height          =   1575
  107.       Index           =   4
  108.       Left            =   60
  109.       MousePointer    =   2  'Cross
  110.       Stretch         =   -1  'True
  111.       Top             =   1740
  112.       Width           =   1515
  113.    End
  114.    Begin VB.Image img_thumb 
  115.       Height          =   1575
  116.       Index           =   3
  117.       Left            =   4920
  118.       MousePointer    =   2  'Cross
  119.       Stretch         =   -1  'True
  120.       Top             =   60
  121.       Width           =   1515
  122.    End
  123.    Begin VB.Image img_thumb 
  124.       Height          =   1575
  125.       Index           =   2
  126.       Left            =   3300
  127.       MousePointer    =   2  'Cross
  128.       Stretch         =   -1  'True
  129.       Top             =   60
  130.       Width           =   1515
  131.    End
  132.    Begin VB.Image img_thumb 
  133.       Height          =   1575
  134.       Index           =   1
  135.       Left            =   1680
  136.       MousePointer    =   2  'Cross
  137.       Stretch         =   -1  'True
  138.       Top             =   60
  139.       Width           =   1515
  140.    End
  141.    Begin VB.Image img_thumb 
  142.       Height          =   1575
  143.       Index           =   0
  144.       Left            =   60
  145.       MousePointer    =   2  'Cross
  146.       Stretch         =   -1  'True
  147.       Top             =   60
  148.       Width           =   1515
  149.    End
  150. Attribute VB_Name = "frm_thumbs"
  151. Attribute VB_GlobalNameSpace = False
  152. Attribute VB_Creatable = False
  153. Attribute VB_PredeclaredId = True
  154. Attribute VB_Exposed = False
  155. Option Explicit
  156. '**********************************************************************
  157. 'PRIVATE VARIABLES
  158. '**********************************************************************
  159.     Private pics() As pic
  160.     Private noofpics As Integer
  161.     Private strpath As String
  162.     Private current As Integer
  163. '***********************************
  164. 'FOLDER IMAGE GATHERING
  165. '***********************************
  166.     'GET FOLDER CONTENTS
  167.     Public Function scan_folder(spath As String) As Integer
  168.         On Error Resume Next
  169.         strpath = spath
  170.         Dim fs, f, fc, f1
  171.         Dim rndpos As Long
  172.         Dim chkext As Integer
  173.         Set fs = CreateObject("Scripting.FileSystemObject")
  174.         Set f = fs.GetFolder(spath)
  175.         Set fc = f.Files
  176.         noofpics = count_images(spath)
  177.         scan_folder = noofpics
  178.         If noofpics = 1 Then
  179.             MsgBox "There was only picture in the folder so it has been opened as normal", vbOKOnly, "Slideshow error"
  180.             frm_main.file_open (spath & onlyfile)
  181.             Unload Me
  182.         Else
  183.             frm_loading.pro_progress = 0
  184.             frm_loading.pro_progress.Max = noofpics
  185.             If noofpics > 12 Then
  186.                 hsc_scroll.Max = noofpics - 12
  187.             Else
  188.                 hsc_scroll.Visible = False
  189.             End If
  190.             noofpics = noofpics - 1
  191.             frm_loading.Caption = "Creating thumbnails, please wait..."
  192.             ReDim pics(noofpics) As pic
  193.             For Each f1 In fc
  194.                 DoEvents
  195.                 frm_loading.pro_progress.Value = frm_loading.pro_progress.Value + 1
  196.                 For chkext = 1 To noof_supported_extensions
  197.                     If InStr(1, f1.Name, supported_extensions(chkext).strdata, vbTextCompare) Then
  198.                         Randomize
  199.                         rndpos = Int((noofpics + 1) * Rnd)
  200.                         While pics(rndpos).filename <> ""
  201.                             DoEvents
  202.                             rndpos = Int((noofpics + 1) * Rnd)
  203.                         Wend
  204.                         pics(rndpos).filename = f1.Name
  205.                     End If
  206.                 Next chkext
  207.             Next
  208.         End If
  209.     End Function
  210. '***********************************
  211. 'DISPLAY THUMBS
  212. '***********************************
  213.     Public Sub display_thumbs()
  214.         Dim thumbnum As Integer
  215.         Dim first As Integer
  216.         first = hsc_scroll
  217.         For thumbnum = 0 To 11
  218.             display_pic thumbnum, first
  219.             first = first + 1
  220.             If first > noofpics Then Exit Sub
  221.         Next thumbnum
  222.     End Sub
  223. '***********************************
  224. 'IMAGE PUBLIC SUBS
  225. '***********************************
  226.     'NEXT PICTURE MANUAL
  227.     Public Sub display_pic(Index As Integer, picindex As Integer)
  228.     On Error GoTo openerror
  229.         If verify_file(strpath & pics(picindex).filename) Then
  230.             img_thumb(Index).Picture = LoadPicture(strpath & pics(picindex).filename)
  231.             img_thumb(Index).ToolTipText = "Double click to open " & pics(picindex).filename
  232.             img_thumb(Index).Tag = strpath & pics(picindex).filename
  233.             Exit Sub
  234.         Else
  235. openerror:
  236.             img_thumb(Index).Picture = ils_images.ListImages("noimage").Picture
  237.             img_thumb(Index).Tag = ""
  238.             Exit Sub
  239.         End If
  240.     End Sub
  241. '***********************************
  242. 'SCROLL EVENTS
  243. '***********************************
  244.     Private Sub hsc_scroll_Change()
  245.         display_thumbs
  246.     End Sub
  247. '***********************************
  248. 'IMAGE EVENTS
  249. '***********************************
  250.     Private Sub img_thumb_DblClick(Index As Integer)
  251.         If img_thumb(Index).Tag <> "" Then frm_main.file_open img_thumb(Index).Tag
  252.     End Sub
  253.